﻿module ExceptionMonad

type StatementOrException<'p> = 
  | Statement of 'p 
  | Exception of string


type M<'a,'s> = 's -> StatementOrException<'a *'s>
   
type StateBuilder() =
  member this.Return(x:'a) : M<'a,'s> = //return
    fun s -> Statement (x,s)

  member this.Bind(p:M<'a,'s>, k:'a -> M<'b,'s>) : M<'b,'s>  = //let!
    fun s -> 
      match p s with
      | Exception s -> Exception s
      | Statement (x, s') -> (k x) s'

  member this.Combine(p, k )  = //do!
    this.Bind(p, fun _ -> k)

  member this.For(items:seq<'a>, body) = //monadic for loop
    fun s ->
      if items |> Seq.length = 0 then 
        this.Return() s
      else
        let hd,tl = items |> Seq.head, items |> Seq.skip 1
        this.Combine(body hd, this.For(tl, body)) s

  member this.Delay s = this.Bind(this.Return(), s)
  member this.Run s = s
  member this.Zero () = fun s -> None
  member this.ReturnFrom p = p  

let get_state : M<'a,'a> = fun s -> Statement(s,s)

let set_state s = fun _ -> Statement((),s)

let fail error = fun s -> Exception (error)

let execute m s = m s